home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d3
/
tscript.arc
/
TSCRIPT.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1985-08-02
|
41KB
|
1,608 lines
Program Wordprocess;
{$C-,V-,I-}
type
TempString = string[80];
const
Digits: array[1..10] of char = ('1','2','3','4','5','6','7','8','9','0');
Positions: array[1..10] of integer = (1,8,18,25,33,39,49,59,67,74);
var
Keynum, Row, Column, I, MaxRow, ScreenRow, Temp1, Temp2, Temp3,
TopMargin, LeftMarg, RightMarg, Num, code, Style, Index, NumEnd,
Position1, Position3, DiskSpace : integer;
Inkey, SecInkey, Choice, ch : char;
Words : array[1..500] of TempString;
Tabset : array[1..80] of boolean;
TextFile : Text;
TempWord, FileName, Test, Typeset : TempString;
Secnum, Row_One, Insertmode, Exit, result, Undermode, Boldmode, Italicmode : boolean;
dosrec : record
ax,bx,cx,dx,bp,si,di,ds,es,flags : integer;
end;
OurDTA : array [ 1..43 ] of byte; { Data Transfer Area buffer }
CurDTAseg, { DTA segment before execution }
CurDTAofs, { DTA offset " " }
OurDTAseg, { DTA segment and offset set after }
OurDTAofs : integer; { start of program }
procedure Fill_In;
var Temprow, Temp : integer;
begin
Window(27,6,52,18);
ClrScr;
Window(1,2,80,23);
Temp := Row;
if ScreenRow>5 then begin
repeat
ScreenRow := ScreenRow - 1;
Row := Row - 1;
until ScreenRow = 5;
end;
if ScreenRow < 5 then begin
repeat
ScreenRow := ScreenRow + 1;
Row := Row + 1;
until ScreenRow = 5;
end;
Temprow := ScreenRow;
for i := 1 to 14 do begin;
GotoXY(27, Temprow);
write(Copy(Words[Row],27,26));
Temprow := Temprow + 1;
Row := Row + 1;
end;
Row := Temp;
end;
procedure DirSetup(InitReset: TempString ;
var error: Integer );
begin
Error := 0;
if InitReset = 'INIT' then
begin {---------- Initialization processes ------------}
For I := 1 to 43 do {Initialize our DTA Buffer}
OurDTA[I]:=0;
dosrec.ax := $2F00; { Save Current DTA pointer}
Intr($21,dosrec); { to be restored later }
CurDTASeg := dosrec.es;
CurDTAOfs := dosrec.bx;
error := dosrec.ax and $FF;
if error = 0 then
begin
OurDTAseg := seg(OurDTA); {Point DOS to our }
OurDTAofs := ofs(OurDTA); {DTA Buffer }
dosrec.ax := $1A00;
dosrec.ds := OurDTASeg;
dosrec.dx := OurDTAOfs;
Intr($21,dosrec);
error := dosrec.ax and $FF;
end;
end;
end;
procedure DirGet (Func : TempString ;
Asciiz : TempString ;
var FileName : TempString ;
Option : Integer ;
var Error : Integer );
begin
error := 0;
If Func = 'FIRST' then
begin
asciiz[length(asciiz)+1]:=chr(0); { Terminate name with hex00 }
dosrec.ax := $4E00; { Get first directory entry }
dosrec.ds := seg(Asciiz); { Point to the file mask }
dosrec.dx := ofs(Asciiz);
dosrec.dx := dosrec.dx + 1; { Point past string's length byte }
dosrec.cx := Option;
end
else
dosrec.ax := $4F00; {Get next directory entry}
Intr($21,dosrec); { Execute MSDos call }
error := dosrec.ax and $FF; { Get error return }
I := 1;
If error = 0 then
Repeat { Get name from the DTA area }
FileName[I]:=chr(mem[OurDTASeg:OurDTAOfs + 29 + I]);
I := I + 1;
Until (not (FileName[I - 1] in [' '..'~']));
FileName[0]:=chr(I-1) { set string length because assigning }
{ by element does not set length }
end;
procedure PrintDir;
var err : integer;
firstname, nextnames : TempString;
Begin
Fill_In;
ClrScr;
DirSetup('INIT',err);
DirGet('FIRST','????????.???'+chr(0),FIRSTNAME,8,err);
writeln('Directory of A: Volume name is ',FIRSTNAME);
writeln('Only Turbo Script files listed.');
writeln;
DirSetup('INIT',err);
DirGet('FIRST','A:????????.FIL'+chr(0),Firstname,3,err);
write(copy(Firstname,1,Pos('.',Firstname)-1):8,' ');
repeat
DirGet('NEXT','A:????????.FIL'+chr(0),Nextnames,3,err);
write(copy(Nextnames,1,pos('.',Nextnames)-1):8,' ');
until err<>0;
dosrec.ax := $3600;
dosrec.dx := 0;
Intr($21, dosrec);
writeln;
writeln(' ',dosrec.bx,'k bytes free');
writeln;
writeln;
writeln('Press any key to continue...');
read(Kbd, Choice);
end;
procedure PrintWords;
begin
ClrScr;
for i := 1 to 21 do begin
if Words[i] = Test then writeln else writeln(Words[i]);
end;
write(Words[22]);
end;
function Replicate ( Count, Ascii : Integer ) : TempString;
var
Temp : TempString;
I : Byte;
Begin
Temp := '';
For I := 1 to Count do
Temp := Temp + chr(Ascii);
Replicate := Temp;
end;
procedure ClearBuf;
var dummy : char;
begin
while KeyPressed do read(Kbd, dummy);
end;
procedure Data_In(Line : integer;Var FileName : TempString);
var
count, Maxcount : integer;
Letter : char;
NoGood, NameSet, ValidLetters, LowerCase : set of char;
begin
FileName := '--------.---';
count := 1;
ValidLetters := ['!'..'~'];
LowerCase := ['a'..'z'];
NoGood := ['*','<'..'?','[',']',' ','.'];
NameSet := ValidLetters - NoGood;
GotoXY(1,Line);
write(FileName);
GotoXY(1,Line);
Maxcount := Length(FileName);
repeat
GotoXY(count,Line);
read(Kbd, Letter);
if Letter in Lowercase then Letter := UpCase(Letter);
if (Letter = ' ') or (Letter = '.') then count := maxcount - 3;
if Letter in NameSet
then begin
FileName[count] := Letter;
GotoXY(1,Line);
Write(FileName);
count := count + 1;
end
else
if Letter = chr(8) then begin
if count = Pos('.',FileName) + 1 then count := count - 2
else count := count - 1;
if count < 1 then count := 1;
FileName[count] := '-';
GotoXY(1,Line);
write(FileName);
end
else if (Letter <> ' ') and (Letter <> chr(13)) and (ord(Letter) <> 27)
and (Letter <> '.') then write(chr(7));
if count = Pos('.',FileName) then count := count + 1;
until (count = Maxcount + 1) or (Letter = chr(13)) or (ord(Letter) = 27);
if (ord(Letter) = 27) or (count=1) then Exit := true else begin
if Copy(Filename, Maxcount-2,1) = '-' then begin
Filename := Copy(Filename, 1, Length(Filename)-4);
Filename := Filename + '.FIL';
end;
repeat
Delete(Filename,Pos('-',Filename),1);
until Pos('-',Filename)=0;
GotoXY(1,Line);
Write(' ');
GotoXY(1,Line);
Write(Filename);
end;
end;
procedure Initialize;
begin
CrtInit;
Window(1,1,80,25);
GotoXY(1,1);
Write(Replicate(80,205));
GotoXY(1,24);
Write(Replicate(80,196));
GotoXY(16,1);
Write('Turbo Script');
GotoXY(1,25);
LowVideo;
write('Help ':6,'Ser/Rep ':10,'Tabs ':7,'Title ':8,'DOS ':6);
write('InsLine ':10,'DelLine ':10,'Print ':8,'Load ':7,'Save ':7);
NormVideo;
for i := 1 to 10 do begin
GotoXY(Positions[i], 25);
write(Digits[i]);
end;
Window(1,2,80,23);
Row := 1;
Column := 1;
ScreenRow := 1;
MaxRow := 1;
TempWord := Replicate(79,32);
Test := TempWord;
for i := 1 to 500 do Words[i] := TempWord;
TempWord := '';
Insertmode := false;
Undermode := false;
Boldmode := false;
Italicmode := false;
Exit := false;
NumEnd := 1;
for i := 1 to 80 do Tabset[i] := false;
Tabset[6] := true;
Tabset[40] := true;
end;
procedure Printrow;
begin
Window(1,1,80,25);
GotoXY(43,1);
writeln('Row = ',Row : 3,' Column = ',Column : 2);
Window(1,2,80,23);
end;
procedure Menu(Title, Choice1, Choice2, Choice3, Choice4, Choice5 : TempString);
begin
ClearBuf;
ClrScr;
writeln(Title);
writeln;
writeln(Choice1);
writeln(Choice2);
writeln(Choice3);
writeln(Choice4);
writeln(Choice5);
writeln;
write('? ');
GotoXY(1,10);
write('Press Esc to exit');
GotoXY(3,9);
read(Kbd, Choice);
If ord(Choice) = 27 then Exit := true else Val(Choice, Num, code);
if (code>0) or (Num>5) or (Num<1) then Num := 0;
end;
procedure Frame(UpperLeftX, UpperLeftY, LowerRightX, LowerRightY: Integer);
var
i: Integer;
begin
GotoXY(UpperLeftX, UpperLeftY); Write(chr(201));
for i:=UpperLeftX+1 to LowerRightX-1 do Write(chr(205));
Write(chr(187));
for i:=UpperLeftY+1 to LowerRightY-1 do
begin
GotoXY(UpperLeftX , i); Write(chr(186));
GotoXY(LowerRightX, i); Write(chr(186));
end;
GotoXY(UpperLeftX, LowerRightY);
Write(chr(200));
for i:=UpperLeftX+1 to LowerRightX-1 do Write(chr(205));
Write(chr(188));
end { Frame };
procedure CommandWindow(Strg : TempString);
begin
Window(28,6,52,18);
ClrScr;
Window(1,2,80,23);
Frame(28,5,52,17);
Window(30,7,50,17);
GotoXY(1,1);
write(Replicate(20,223));
GotoXY(1,2);
write(Strg);
GotoXY(1,3);
write(Replicate(20,220));
end;
procedure ClearScreen;
begin
Temp1 := Row;
Temp2 := ScreenRow;
Temp3 := Column;
CommandWindow('');
ClrScr;
GotoXY(1,3);
write('Clear Memory, Erase Text?');
writeln;
writeln;
write('ARE YOU SURE? (Y/N) ');
read(Kbd,Inkey);
write(Inkey);
if (Inkey = 'y') or (Inkey = 'Y') then begin
TempWord := Replicate(79,32);
for i := 1 to 500 do Words[i] := TempWord;
Row := 1;
ScreenRow := 1;
Column := 1;
MaxRow := 1;
end
else begin
Exit := true;
Row := Temp1;
ScreenRow := Temp2;
Column := Temp3;
end;
end;
function GetKey(var secnum : boolean; var Inkey : char) : boolean;
begin
if KeyPressed then begin
result := true;
dosrec.ax := $0800;
msdos(dosrec);
Inkey := chr(lo(dosrec.ax));
Secnum := ord(Inkey) = 0;
if Secnum then begin
dosrec.ax := $0800;
msdos(dosrec);
Keynum := ord(chr(lo(dosrec.ax)));
end
else if ord(Inkey) <= 27 then begin
Secnum := true;
Keynum := ord(Inkey);
end
else begin
Keynum := ord(Inkey);
Secnum := false;
end
end
else begin
Getkey := false;
secnum := false;
end;
end;
procedure WordWrap;
var SpacePosition : integer;
begin
SpacePosition := 79;
TempWord := Words[Row];
Sound(400);
Delay(20);
NoSound;
repeat
SpacePosition := SpacePosition - 1;
until TempWord[SpacePosition] = ' ';
if SpacePosition < 2 then SpacePosition := 2;
Words[Row+1] := Copy(Words[Row], SpacePosition + 1, 79-(SpacePosition+1)) +
Inkey + Copy(Words[Row+1], 1, SpacePosition - 2);
Words[Row] := Copy(Words[Row], 1, SpacePosition - 1) + Replicate(80 - SpacePosition, 32);
ScreenRow := ScreenRow + 1;
if ScreenRow > 22 then begin
ScreenRow := 22;
GotoXY(1,1);
DelLine;
GotoXY(1, ScreenRow-1);
writeln(Words[Row]);
write(Words[Row+1]);
end
else begin
GotoXY(1, ScreenRow-1);
writeln(words[Row]);
write(Words[Row+1]);
end;
Row := Row + 1;
if Row > MaxRow then MaxRow := Row;
Column := Length(Words[Row])- SpacePosition + 3;
end;
procedure Character;
begin
if Column = 79 then WordWrap else
begin
GotoXY(Column,ScreenRow);
write(Inkey);
Insert(Inkey, Words[Row], Column);
if not Insertmode then Delete(Words[Row],Column + 1,1);
Column := Column + 1;
if Column = 70 then begin
Sound(1010);
Delay(10);
NoSound;
end;
end;
end;
procedure Del;
begin
ch := Copy(Words[Row], Column, 1);
Delete(Words[Row], Column, 1);
Words[Row] := Words[Row] + ' ';
if ch in ['▌','▐'] then boldmode := not boldmode;
if ch in ['«','»'] then italicmode := not italicmode;
GotoXY(1, ScreenRow);
if ScreenRow = 22 then write(Words[Row]) else writeln(Words[Row]);
end;
procedure Backspace;
begin
if Column > 1 then begin
Column := Column - 1;
Del;
end;
end;
procedure InsertLine;
begin
InsLine;
for i := MaxRow + 1 downto Row do Words[i+1] := Words[i];
Words[Row] := Replicate(79,32);
MaxRow := MaxRow + 1;
end;
procedure Enter;
begin
column := 1;
row := row + 1;
if row > MaxRow then MaxRow := Row;
ScreenRow := Screenrow + 1;
if ScreenRow > 22 then begin
GotoXY(1,1);
DelLine;
ScreenRow := 22;
GotoXY(1, ScreenRow);
write(Words[Row]);
end;
GotoXY(Column, Screenrow);
if InsertMode then InsertLine;
end;
procedure CursorLeft;
begin
column := column - 1;
if column < 1 then begin
column := 79;
if Row = 1 then Row := 1 else Row := Row - 1;
if ScreenRow = 1 then ScreenRow := 1 else ScreenRow := ScreenRow - 1;
end
end;
procedure CursorRight;
begin
column := column + 1;
If Column > 79 then begin
Column := 1;
Row := Row + 1;
if Row > MaxRow then MaxRow := Row;
If ScreenRow < 22 then ScreenRow := ScreenRow + 1 else begin
ScreenRow := 22;
GotoXY(1,1);
DelLine;
GotoXY(1, ScreenRow);
write(Words[Row]);
end;
end;
end;
procedure CursorUp;
var Count : integer;
begin
if row = 1 then Row_One := true else Row_One := false;
row := row - 1;
if row < 1 then row := 1;
if (ScreenRow = 1) and not Row_One then begin
GotoXY(1,1);
InsLine;
GotoXY(1,1);
write(Words[Row]);
end;
ScreenRow := ScreenRow - 1;
if ScreenRow < 1 then ScreenRow := 1;
end;
procedure CursorDown;
begin
row := row + 1;
if row > MaxRow then MaxRow := Row;
ScreenRow := ScreenRow + 1;
if ScreenRow > 22 then begin
ScreenRow := 22;
GotoXY(1,1);
DelLine;
GotoXY(1, ScreenRow);
write(Words[Row]);
end;
end;
procedure Ins;
begin
if Insertmode then Insertmode := false
else Insertmode := true;
Window(1,1,80,25);
GotoXY(1,1);
if Insertmode = true then write('Insert') else write(Replicate(7,205));
end;
procedure Warning;
begin
ClrScr;
Writeln(chr(7),'<<<<<<<<<<>>>>>>>>>> ');
writeln('That file already');
writeln(' exists.');
writeln;
writeln('Replace it (Y/N)?');
writeln;
writeln('<<<<<<<<<<>>>>>>>>>>');
GotoXY(19,6);
Read(Kbd, Choice);
GotoXY(19,6);
write(Choice);
if (Choice = 'n') or (Choice = 'N') then Exit := true;
end;
procedure Savefile;
var Exist : boolean;
begin
Temp1 := Row;
Temp2 := ScreenRow;
Temp3 := Column;
CommandWindow(' Save File');
GotoXY(1,5);
writeln('Enter File Name:');
write('Default = .FIL');
GotoXY(1,10);
write('Press Esc to exit');
Data_In(8, Filename);
if Exit = false then begin
GotoXY(1,10);
Assign(TextFile, Filename);
{$I-}
Reset(TextFile);
{$I+}
Exist := (IOresult = 0);
if Exist = true then Warning;
if Exit = false then begin
Rewrite(TextFile);
Row := 1;
for i := 1 to MaxRow + 1 do begin
Writeln(TextFile, Words[Row]);
Row := Row + 1;
end;
Close(TextFile);
end;
end;
Row := Temp1;
Fill_In;
Row := Temp1;
ScreenRow := Temp2;
Column := Temp3;
end;
procedure Loadfile;
var Exist : boolean;
begin
Temp1 := Row;
Temp2 := ScreenRow;
Temp3 := Column;
CommandWindow(' Load File');
GotoXY(1,5);
writeln('Enter File Name:');
write('Default = .FIL');
GotoXY(1,10);
write('Press Esc to exit');
Data_In(8, Filename);
if Exit = false then begin
GotoXY(1,10);
Assign(TextFile, Filename);
{$I-}
Reset(TextFile);
{$I+}
Exist := (IOresult = 0);
if Exist = true then begin
TempWord := Test;
ClearScreen;
if Exit = false then begin
While EOF(Textfile) = false do begin
Readln(TextFile, Words[Row]);
if Length(Words[Row]) >= 80 then Words[Row] := Copy(Words[Row], 1, 79);
Row := Row + 1;
end;
Close(TextFile);
MaxRow := Row + 1;
Window(27,6,52,18);
ClrScr;
Window(1,2,80,23);
ClrScr;
GotoXY(1,1);
PrintWords;
Row := 1;
Column := 1;
ScreenRow := 1;
end;
end;
if Exist=false then begin
ClrScr;
writeln(chr(7));
writeln('File does not exist');
Delay(1000);
Exit := true;
end;
end;
if Exit = true then begin
Row := Temp1;
Fill_In;
Row := Temp1;
ScreenRow := Temp2;
Column := Temp3;
end;
end;
procedure SetMargins;
begin
TopMargin := 0;
Menu('Select Top Margin:','1. 1"','2. 1 1/2"','3. 2"','4. None','');
if Num in [1..3] then TopMargin := (Num + 1) * 3;
if Exit = false then begin
ClrScr;
writeln('Set Horizontal Margins (Y/N)');
read(Kbd, Choice);
if (Choice = 'Y') or (Choice = 'y') then begin
writeln;
writeln('Enter Left margin:');
Read(LeftMarg);
writeln;
writeln('Enter Right margin:');
Read(RightMarg);
Typeset := Typeset + chr(27) + chr(77) + chr(LeftMarg) +
chr(27) + chr(81) + chr(RightMarg);
end;
end;
end;
procedure PrintTitle;
var Titlename : TempString;
spacing : integer;
begin
CommandWindow(' Title');
GotoXY(1,5);
writeln('Enter title:');
read(Titlename);
Write(Lst, chr(27), chr(71), chr(27), chr(69), chr(27), chr(14));
Spacing := 20 - Length(Titlename) div 2;
Spacing := Spacing + Length(Titlename);
writeln(Lst, Titlename : Spacing);
writeln(Lst, chr(27), chr(64), Typeset);
ClrScr;
GotoXY(1,3);
TextColor(White + Blink);
writeln('Printing...');
TextColor(White);
writeln;
writeln('<< Press any key >>');
writeln('<< to abort. >>');
end;
procedure SuperScript;
begin
Write(Lst, chr(27), chr(83), chr(0));
Index := Index + 1;
repeat
Write(Lst, TempWord[Index]);
Index := Index + 1;
until not(TempWord[Index] in ['0'..'9','-']) = true;
write(Lst, chr(27), chr(84));
end;
procedure SubScript;
begin
Write(Lst, chr(27), chr(83), chr(1));
Index := Index + 1;
repeat
Write(Lst, TempWord[Index]);
Index := Index + 1;
until not(TempWord[Index] in ['0'..'9']) = true;
write(Lst, chr(27), chr(84));
end;
procedure UnderLine;
begin
if Undermode = true then begin
Undermode := false;
Write(Lst, chr(27), chr(45), chr(0));
end
else begin
Undermode := true;
Write(Lst, chr(27), chr(45), chr(1));
end;
end;
procedure Boldface;
begin
if Boldmode = true then begin
Boldmode := false;
Write(Lst, chr(27), chr(72));
end
else begin
Boldmode := true;
Write(Lst, chr(27), chr(71));
end;
end;
procedure Italics;
begin
if Italicmode = true then begin
Italicmode := false;
Write(Lst, chr(27), chr(53));
end
else begin
Italicmode := true;
Write(Lst, chr(27), chr(52));
end;
end;
procedure PrintFile;
var lines, Linespaces, j : integer;
Perfover, Special : boolean;
begin
Temp1 := Row;
Temp2 := ScreenRow;
Temp3 := Column;
if Boldmode = true then I := 2656;
CommandWindow(' Print file');
Typeset := chr(27)+chr(64);
GotoXY(1,7);
writeln('Press any key...');
repeat until KeyPressed;
repeat
Menu('Choose print style:', '1. Elite', '2. Boldface', '3. Italic',
'4. Compressed', '5. Continue');
Case Num of
1 : Typeset := Concat(Typeset,chr(27),chr(66),chr(2),
chr(27),chr(77),chr(8));
2 : Typeset := Concat(Typeset,chr(27),chr(71));
3 : Typeset := Concat(Typeset,chr(27),chr(52));
4 : Typeset := Concat(Typeset,chr(15),chr(27),chr(77),chr(32));
5 :;
else
if Exit = false then write(chr(7));
end;
if Num in [1..4] then begin
Sound(300);
Delay(50);
NoSound;
write(' Done.');
Delay(300);
end;
until (Num = 5) or (Exit = true);
if Exit = false then begin
SetMargins;
ClrScr;
if Exit = false then begin
Typeset := Typeset + chr(27) + chr(82) + chr(Topmargin);
ClrScr;
writeln('Set line spacing:');
writeln;
writeln('1. Single');
writeln('2. Double');
writeln('3. Triple');
writeln;
read(Kbd, Choice);
Val(Choice, Num, code);
if (Num in [1..3]) and (code = 0) then Linespaces := Num;
writeln;
Write('Do you want automaticperf skip over? ');
read(Kbd, Choice);
if (Choice = 'Y') or (Choice = 'y') then Perfover := true else
Perfover := false;
if Perfover = true then Typeset := Typeset+chr(27)+chr(78)+chr(Topmargin);
ClearBuf;
ClrScr;
Writeln('Scroll paper to perf');
Writeln('and press any key to');
writeln('print, or Esc to');
writeln('exit');
read(Kbd, Choice);
if ord(Choice) <> 27 then begin
ClrScr;
GotoXY(1,3);
TextColor(White + Blink);
writeln('Printing...');
TextColor(White);
writeln;
writeln('<< Press any key >>');
writeln('<< to abort. >>');
writeln(Lst, Typeset);
i := 0;
for j := 1 to TopMargin do write(Lst,chr(10));
Test := Replicate(79,32);
While (not KeyPressed) and (i < MaxRow + 1) do begin
TempWord := Test;
i := i + 1;
if Copy(Words[i],1,5) = 'Title' then PrintTitle
else begin
TempWord := Words[i];
Index := 0;
if TempWord = Test then write(Lst, chr(13)) else
begin
repeat
Index := Index + 1;
If TempWord[Index] = '\' then Underline;
If TempWord[Index] = '~' then SuperScript;
if TempWord[Index] = '|' then Subscript;
if TempWord[Index] in ['«','»'] then Italics;
if TempWord[Index] in ['▐','▌'] then Boldface;
if not(TempWord[Index] in ['\','~','|','▐','▌','«','»'])
= true then Write(Lst, TempWord[Index]);
until Index >= 79;
Write(Lst, chr(13));
end;
for j := 1 to Linespaces do write(Lst, chr(10));
end;
end;
end;
end;
end;
Fill_In;
Row := Temp1;
ScreenRow := Temp2;
Column := Temp3;
if I = 2656 then Boldmode := true;
end;
procedure Search;
var SearchString, Temp : TempString;
Pointer, Position, Line, Len : integer;
begin
Line := 2;
CommandWindow(' Search');
GotoXY(1, 5);
writeln('Enter String: ');
writeln;
write('? ');
read(SearchString);
Len := Length(SearchString);
Fill_In;
ClrScr;
for i := 1 to MaxRow do begin
Pointer := Pos(SearchString, Words[i]);
if (Exit = false) and (Pointer > 0) then begin
Temp := Words[i];
Position := Pointer;
GotoXY(1, Line);
LowVideo;
write(Temp);
NormVideo;
While Pointer > 0 do begin
GotoXY(Position, Line);
write(Copy(Temp, Pointer, Len));
Temp := Copy(Temp, Pointer + Len + 1,
80 - Pointer + Len + 1);
Pointer := Pos(SearchString, Temp);
Position := Position + Pointer + Len;
end;
writeln;
Line := Line + 1;
if Line = 20 then begin
GotoXY(1, 22);
write('Press any key to continue or Esc to exit ...');
read(Kbd, Choice);
if ord(Choice) = 27 then Exit := true else begin
ClrScr;
line := 2;
end;
end;
if line > 2 then begin
read(Kbd, Choice);
if ord(Choice) = 27 then Exit := true;
end;
end;
end;
writeln;
writeln;
writeln('End of search');
repeat until Keypressed;
end;
procedure Replace;
var SearchString, Replacement : TempString;
Pointer, Line, Len : integer;
begin
Line := 2;
CommandWindow(' Replace');
GotoXY(1, 5);
writeln('Enter String: ');
writeln;
write('? ');
read(SearchString);
writeln;
writeln('Enter Replacement:');
writeln;
write('? ');
read(Replacement);
Len := Length(Replacement);
Fill_In;
ClrScr;
for i := 1 to MaxRow do begin
Pointer := Pos(SearchString, Words[i]);
if (Pointer > 0) and (Exit = false) then begin
GotoXY(1, Line);
LowVideo;
write(Words[i]);
NormVideo;
GotoXY(Pointer, Line);
write(Copy(Words[i], Pointer, Length(SearchString)));
GotoXY(1,22);
write('Replace Y/N');
read(Kbd, Choice);
if ord(Choice) = 27 then Exit := true else if (Choice = 'Y') or
(Choice = 'y') then begin
Words[i] := Copy(Words[i],1,Pointer-1) + Replacement +
Copy(Words[i], Pointer + Length(SearchString), 80-Len+1);
GotoXY(1, Line);
LowVideo;
write(Words[i]);
NormVideo;
GotoXY(Pointer, Line);
write(Copy(Words[i], Pointer, Len));
end
else begin
GotoXY(80, Line);
write('N');
end;
Line := Line + 1;
if Line = 20 then begin
writeln('Press any key to continue or Esc to exit ...');
read(Kbd, Choice);
if ord(Choice) = 27 then Exit := true else begin
ClrScr;
line := 2;
end;
end;
end;
end;
writeln;
write('End of replace');
repeat until Keypressed;
end;
procedure Menu_S_R;
var Good : boolean;
begin
Temp1 := Row;
Temp2 := ScreenRow;
Temp3 := Column;
CommandWindow(' Search / Replace');
Good := True;
GotoXY(1,5);
Writeln('Enter Choice: ');
writeln;
writeln('1. Search');
writeln('2. Replace');
writeln;
write('? ');
GotoXY(1,10);
write('Press Esc to exit');
read(Kbd, Choice);
if ord(Choice) = 27 then code := 1 else Val(Choice, Num, code);
if (code = 0) and (Num in [1,2]) then
case Num of
1 : Search;
2 : Replace;
end
else begin
if code = 0 then write(chr(7));
Fill_In;
Row := Temp1;
ScreenRow := Temp2;
Column := Temp3;
Good := false;
end;
if Good then begin
Row := 1;
Column := 1;
ScreenRow := 1;
ClrScr;
GotoXY(1,1);
PrintWords;
end;
end;
procedure DelFile;
var Filename : TempString;
Exist : boolean;
begin
ClrScr;
writeln('Enter file to Delete:');
Data_In(3, FileName);
Assign(Textfile, FileName);
{$I-}
Reset(Textfile);
{$I+}
Exist := (IOresult = 0);
if Exist = true then begin
Erase(Textfile);
GotoXY(1,6);
writeln('File deleted');
Delay(1000);
end
else begin
GotoXY(1,6);
writeln(chr(7),'File does not exist');
Delay(1000);
end;
end;
procedure RenFile;
var OldName, NewName : TempString;
Exist : boolean;
begin
ClrScr;
Writeln('Enter old file name:');
Data_In(3, OldName);
Assign(Textfile, OldName);
{$I-}
Reset(Textfile);
{$I+}
Exist := (IOresult = 0);
if Exist = true then begin
Close(Textfile);
writeln;
writeln;
writeln('Enter new name:');
Data_In(6, NewName);
Assign(Textfile, NewName);
{$I-}
Reset(Textfile);
{$I+}
Exist := (IOresult = 0);
if Exist = false then begin
Close(Textfile);
Assign(Textfile, OldName);
Rename(Textfile, NewName);
Close(Textfile);
end
else begin
GotoXY(1,8);
write(chr(7),'New file already exists');
Delay(1000);
end;
end
else begin
GotoXY(1,8);
write(chr(7),'File does not exist');
Delay(1000);
end;
end;
procedure Copyfile;
var Firstname, SecondName : TempString;
SecondFile : Text;
Exist : boolean;
begin
ClrScr;
Writeln('Enter source file:');
Data_In(3, Firstname);
Assign(Textfile, Firstname);
{$I-}
Reset(Textfile);
{$I+}
Exist := (IOresult = 0);
if Exist = true then begin
writeln;
writeln;
writeln('Enter new name:');
Data_In(6, SecondName);
Assign(SecondFile, SecondName);
{$I-}
Reset(SecondFile);
{$I+}
Exist := (IOresult = 0);
if Exist = false then begin
Close(SecondFile);
Rewrite(SecondFile);
writeln;
writeln;
writeln('Copying......');
while EOF(Textfile) = false do begin
readln(Textfile, TempWord);
Writeln(SecondFile, TempWord);
TempWord := '';
end;
Close(Textfile);
Close(SecondFile);
end
else begin
GotoXY(1,8);
write(chr(7),'New file already exists');
Delay(1000);
end;
end
else begin
GotoXY(1,8);
write(chr(7),'File does not exist');
Delay(1000);
end;
end;
procedure DosMenu;
var j, Inum : integer;
begin
Inum := 1;
Temp1 := Row;
Temp2 := ScreenRow;
Temp3 := Column;
CommandWindow(' DOS Menu');
GotoXY(1,5);
writeln('1. Directory');
writeln('2. Delete');
writeln('3. Rename');
writeln('4. Copy file');
writeln('5. Exit to DOS');
write('? ');
read(Kbd, Choice);
if ord(Choice)<>27 then begin
Val(Choice, Num, code);
case Num of
1 : begin
PrintDir;
Inum := 3333;
end;
2 : DelFile;
3 : RenFile;
4 : CopyFile;
5 : begin
ClrScr;
GotoXY(1,4);
Writeln('Exit Turbo Script,');
Writeln;
Write('Erase memory (Y/N)? ');
Read(Kbd, Choice);
if (Choice = 'Y') or (Choice = 'y') then NumEnd := 9999
else NumEnd := 0;
end;
else
write(chr(7));
end;
if Inum = 3333 then begin
Row := 1;
ScreenRow := 1;
Column := 1;
ClrScr;
PrintWords;
end;
end;
if Inum <> 3333 then begin
Fill_In;
Row := Temp1;
ScreenRow := Temp2;
Column := Temp3;
end;
end;
procedure TabMenu;
Var Num, code : integer;
begin
Temp1 := Row;
Temp2 := ScreenRow;
Temp3 := Column;
CommandWindow(' Tab Menu');
GotoXY(1,5);
writeln('Enter Choice:');
writeln;
writeln('1. Set');
writeln('2. Clear');
writeln('3. Purge');
writeln;
read(Kbd, Inkey);
Val(Inkey, Num, code);
if code = 0 then
case Num of
1 : Tabset[Column] := true;
2 : Tabset[Column] := false;
3 : for i := 1 to 79 do Tabset[i] := false;
end
else
write(chr(7));
Fill_In;
Row := Temp1;
ScreenRow := Temp2;
Column := Temp3;
end;
procedure FuncPgUp;
var Diff : integer;
begin
if Row >= 22 then begin
Row := Row - 21;
if ScreenRow > Row then ScreenRow := Row;
ClrScr;
GotoXY(1, ScreenRow);
if ScreenRow = 22 then write(Words[Row]) else Writeln(Words[Row]);
if (ScreenRow > 1) and (Row > 1) then begin
GotoXY(1,1);
for i := ScreenRow-1 downto 1 do writeln(Words[Row-i]);
GotoXY(1,ScreenRow + 1);
if ScreenRow < 22 then begin
for i := ScreenRow + 1 to 21 do begin
if Words[Row+i-ScreenRow]=Test then writeln else
writeln(Words[Row+i-ScreenRow]);
end;
write(Words[Row+i-ScreenRow+1]);
end
end
else if ScreenRow = 1 then begin
GotoXY(1,2);
for i := ScreenRow + 1 to 21 do begin
if Words[Row+i-1]=Test then writeln else writeln(Words[Row+i-1]);
end;
write(Words[Row+i]);
end
end
else begin
if Row > ScreenRow then begin
GotoXY(1,1);
PrintWords
end;
Row := 1;
ScreenRow := 1;
end;
end;
procedure FuncPgDn;
var Diff : integer;
begin
if Row + 21 < MaxRow then begin
Row := Row + 21;
Diff := ScreenRow;
ClrScr;
GotoXY(1,1);
for i := 1 to 21 do begin
if Words[Row-Diff+i] = Test then writeln else
writeln(Words[Row-Diff+i]);
end;
write(Words[Row-Diff+i+1]);
end;
end;
procedure DeleteLine;
begin
DelLine;
if MaxRow > Row + (23-ScreenRow) then begin
GotoXY(1, 22);
write(Words[Row+(23-ScreenRow)]);
end;
for i := Row to MaxRow + 1 do Words[i] := Words[i+1];
MaxRow := MaxRow - 1;
if Row > MaxRow then MaxRow := Row;
end;
procedure FuncEnd;
var ColTemp : integer;
tchr : char;
begin
ColTemp := 78;
TempWord := Words[Row];
repeat
tchr := TempWord[ColTemp];
ColTemp := ColTemp - 1;
until tchr <> chr(32);
Column := ColTemp + 2;
end;
procedure CtrlFuncEnd;
begin
ClrEol;
Words[Row] := Copy(Words[Row], 1, Column-1) + Replicate(79-Column+1, 32);
end;
procedure PrevWord;
var Temp : char;
Count : integer;
begin
TempWord := Words[Row];
Count := Column - 1;
if TempWord[Column] = ' ' then begin
repeat
Count := Count - 1;
Temp := TempWord[Count];
until Temp <> ' ';
end;
repeat
Count := Count - 1;
Temp := TempWord[Count];
until (Temp = ' ') or (Count < 1);
Column := Count + 1;
if Column < 1 then Column := 1;
end;
procedure NextWord;
var Temp : char;
Count : integer;
begin
TempWord := Words[Row];
Count := Column;
if TempWord[Column] = ' ' then begin
repeat
Count := Count + 1;
Temp := TempWord[Count];
until Temp <> ' ';
Column := Count;
end
else begin
repeat
Count := Count + 1;
Temp := TempWord[Count];
until (Temp = ' ') or (Count > 79);
Column := Count + 1;
end;
if Column > 79 then Column := 79;
end;
procedure Tab;
begin
if Column < 79 then begin
repeat
Column := Column + 1;
until (Tabset[Column] = true) or (Column = 79);
end;
end;
procedure BackTab;
begin
if Column > 1 then begin
repeat
Column := Column - 1;
until (Tabset[Column] = true) or (Column = 1);
end;
end;
procedure Help;
var Count : integer;
begin
Assign(TextFile, 'HELP.HLP');
Reset(TextFile);
While EOF(Textfile) = false do begin
ClrScr;
GotoXY(1,1);
Count := 0;
NormVideo;
repeat
Readln(TextFile, TempWord);
Count := Count + 1;
writeln(TempWord);
until Count = 20;
LowVideo;
GotoXY(1,22);
Write(' < Press');
NormVideo;
Write(' ENTER ');
LowVideo;
Write('to continue >');
read(Kbd, Choice);
end;
Close(TextFile);
NormVideo;
MaxRow := Row + 1;
Row := 1;
Column := 1;
ScreenRow := 1;
ClrScr;
GotoXY(1,1);
PrintWords;
end;
procedure Ascii;
var Ascnum, Repeats, r : integer;
begin
Window(1,1,80,25);
GotoXY(1,1);
Write('Enter ASCII code number: --- ');
GotoXY(26,1);
Read(Ascnum);
GotoXY(1,1);
Write('Enter number of repeats: -- ');
GotoXY(26,1);
Read(Repeats);
GotoXY(1,1);
Write(Replicate(30,205));
GotoXY(16,1);
Write('Turbo Script');
Window(1,2,80,23);
If (Ascnum < 255) and (Repeats < 79) then begin
for r := 1 to Repeats do begin
GotoXY(Column,ScreenRow);
Inkey := chr(Ascnum);
Character;
end;
end
else write(chr(7));
end;
procedure Esc;
begin
Column := 1;
GotoXY(1, WhereY);
ClrEol;
Words[Row] := Replicate(79,32);
end;
procedure BeginFile;
begin
GotoXY(1,1);
if Row > ScreenRow then begin
ClrScr;
PrintWords;
end;
Row := 1;
Column := 1;
ScreenRow := 1;
end;
procedure EndFile;
begin
Row := MaxRow + 1;
ScreenRow := 12;
Column := 1;
Temp1 := Row-11;
ClrScr;
GotoXY(1,1);
for i := 0 to 20 do begin
if Words[Temp1 + i] = Test then writeln else
writeln(Words[Temp1 + i]);
end;
write(Words[Temp1 + 21]);
end;
procedure Title;
begin
Column := 1;
Words[Row] := 'Title' + Replicate(75,32);
GotoXY(Column, Row);
Writeln(Words[Row]);
Row := Row + 1;
if Row > MaxRow then MaxRow := Row;
ScreenRow := ScreenRow + 1;
end;
procedure HandleFunc;
begin
case Keynum of
8 : Backspace;
9 : Tab;
13 : Enter;
15 : Backtab;
23 : begin
if Italicmode then begin
Inkey := chr(175);
Italicmode := false;
end
else begin
Inkey := chr(174);
Italicmode := true
end;
Character;
end;
27 : Esc;
30 : Ascii;
48 : begin
if Boldmode then begin
Inkey := chr(221);
Boldmode := false;
end
else begin
Inkey := chr(222);
Boldmode := true;
end;
Character;
end;
59 : Help;
60 : Menu_S_R;
61 : TabMenu;
62 : Title;
63 : DosMenu;
64 : Insertline;
65 : Deleteline;
66 : Printfile;
67 : Loadfile;
68 : Savefile;
71 : Column := 1;
72 : CursorUp;
73 : FuncPgUp;
75 : CursorLeft;
77 : CursorRight;
79 : FuncEnd;
80 : CursorDown;
81 : FuncPgDn;
82 : Ins;
83 : Del;
115 : PrevWord;
116 : NextWord;
117 : CtrlFuncEnd;
118 : EndFile;
119 : begin
ClearScreen;
Fill_In;
if Exit = false then begin
ClrScr;
ScreenRow := 1;
end;
end;
132 : BeginFile;
else
Sound(200);
Delay(300);
NoSound;
end;
end;
begin
Initialize;
PrintRow;
repeat
Secnum := false;
if Getkey(Secnum, Inkey) then begin
if Secnum then HandleFunc else Character;
PrintRow;
Exit := false;
if Length(Words[Row]) > 79 then Words[Row] := Copy(Words[Row], 1, 79);
if Insertmode then begin
GotoXY(1, ScreenRow);
if ScreenRow = 22 then write(Words[Row]) else writeln(Words[Row]);
end;
GotoXY(Column , ScreenRow);
end;
if IOresult <> 0 then NumEnd := 9999;
until NumEnd = 9999;
Window(1,1,80,25);
ClrScr;
end.